home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / misc / gms_dev.lha / GMSDev / Source / E / Demos / JoyWorm.e < prev    next >
Encoding:
Text File  |  1998-10-02  |  5.3 KB  |  185 lines
  1. /* GMS-example
  2.  * Name:    JoyWorm.e
  3.  * Type:    JoyData/Blitter example
  4.  * Version: 1.0
  5.  * Author:  G. W. Thomassen (0000272e@lts.mil.no)
  6.  * Note:    RamboWorm.e with joystick instead of mouse,
  7.  *          If you got an analog device or whatever, try
  8.  *          changing in the GMSPrefs.. B^)
  9.  */
  10.  
  11. MODULE 'gms/dpkernel','gms/dpkernel/dpkernel','gms/graphics/pictures','gms/files/files',
  12.        'gms/screens','gms/system/register','gms/system/modules','gms/input/joydata',
  13.        'gms/graphics/screens','gms/blitter','gms/graphics/blitter'
  14.  
  15. ENUM NONE,ERR_LIB,ERR_SMOD,ERR_BMOD,ERR_JOY,ERR_SCR,
  16.      ERR_LOAD,ERR_RESTORE,ERR_BOB
  17.  
  18. DEF scr    :PTR TO screen,
  19.     mouse  :PTR TO joydata,
  20.     joy    :PTR TO joydata,
  21.     rstore :PTR TO restore,
  22.     scrmod :PTR TO module,
  23.     bltmod :PTR TO module,
  24.     worm   :PTR TO bob,
  25.     back   :PTR TO picture,
  26.     backfile   :PTR TO filename,
  27.     bobfile    :PTR TO filename,
  28.     wormframes :PTR TO framelist
  29.  
  30. PROC init_all()
  31.   backfile := [ ID_FILENAME,'GMS:demos/data/PIC.Green' ]:filename
  32.   bobfile  := [ ID_FILENAME,'GMS:demos/data/PIC.Rambo' ]:filename
  33.  
  34.   wormframes:=[0,0, 32,0, 64,0, 96,0, 128,0, 160,0, 192,0, 224,0,
  35.                256,0, 288,0, 0,48, 32,48, 64,48, -1,-1]:framelist
  36.  
  37.   IF (dpkbase:=OpenLibrary('GMS:libs/dpkernel.library',0))=NIL THEN Raise(ERR_LIB)
  38.  
  39.   IF (scrmod:=Init([TAGS_MODULE,NIL,
  40.       MODA_NUMBER,    MOD_SCREENS,
  41.       MODA_TABLETYPE, JMP_AMIGAE,
  42.       TAGEND], NIL))=NIL THEN Raise(ERR_SMOD)
  43.       scrbase:=scrmod.modbase
  44.  
  45.   IF (bltmod:=Init([TAGS_MODULE,NIL,
  46.       MODA_NUMBER,    MOD_BLITTER,
  47.       MODA_TABLETYPE, JMP_AMIGAE,
  48.       TAGEND], NIL))=NIL THEN Raise(ERR_BMOD)
  49.       bltbase:=bltmod.modbase
  50.  
  51.   -> first set up mouse!
  52.   IF (mouse:=Init(Get(ID_JOYDATA),NIL))=NIL THEN Raise(ERR_JOY)
  53.  
  54.   /*************************************
  55.    * * * Joystick part starts here * * *
  56.    *************************************/
  57.  
  58.   joy:=Get(ID_JOYDATA)      -> Get the structure
  59.   joy.port:=2               -> Set to port 2 (usually Joystick)
  60.  
  61.   IF (joy:=Init(joy,NIL))=NIL THEN Raise(ERR_JOY)
  62.  
  63.   /*** * Joystick part end, easy isn't it.. * ***/
  64.  
  65.   IF (back:=Load(backfile,ID_PICTURE))=NIL THEN Raise(ERR_LOAD)
  66.   IF (scr:=Get(ID_SCREEN))=NIL THEN Raise(ERR_SCR)
  67. ENDPROC
  68.  
  69. PROC main() HANDLE
  70.   init_all()
  71.  
  72.   CopyStructure(back,scr)
  73.   scr.attrib := SCR_DBLBUFFER
  74.  
  75.   IF (Init(scr,NIL))=NIL THEN Raise(ERR_SCR)
  76.  
  77.   Copy(back.bitmap,scr.bitmap)
  78.  
  79.   CopyBuffer(scr,BUFFER2,BUFFER1)
  80.  
  81.   IF (rstore:=Init([TAGS_RESTORE,NIL,
  82.                     RSA_Entries,1,
  83.                     TAGEND],scr))=NIL THEN Raise(ERR_RESTORE)
  84.  
  85.   IF (worm:=Init([TAGS_BOB,NIL,
  86.                   BBA_GfxCoords,wormframes,
  87.                   BBA_Width, 32,
  88.                   BBA_Height,24,
  89.                   BBA_XCoord,150,
  90.                   BBA_YCoord,150,
  91.                   BBA_Attrib, BBF_RESTORE OR BBF_GENMASKS OR BBF_CLIP,
  92.                     BBA_SourceTags, ID_PICTURE,
  93.                     PCA_Source,     bobfile,
  94.                       PCA_BitmapTags, NIL,
  95.                       BMA_MemType,    MEM_BLIT,
  96.                       TAGEND,NIL,
  97.                     TAGEND,NIL,
  98.                   TAGEND],scr))=NIL THEN Raise(ERR_BOB)
  99.  
  100.   Show(scr)
  101.  
  102.   demo()
  103.  
  104.   Raise(NONE)
  105. EXCEPT DO
  106.   IF joy THEN Free(joy)
  107.   IF mouse THEN Free(mouse)
  108.   IF worm THEN Free(worm)
  109.   IF rstore THEN Free(rstore)
  110.   IF scr THEN Free(scr)
  111.   IF back THEN Free(back)
  112.   IF bltmod THEN Free(bltmod)
  113.   IF scrmod THEN Free(scrmod)
  114.   CloseDPK()
  115.   SELECT exception
  116.   CASE ERR_LIB; WriteF('Error: Opening dpkernel.library\n')
  117.   CASE ERR_SMOD; WriteF('Error: Init() (Screen-module)\n')
  118.   CASE ERR_BMOD; WriteF('Error: Init() (Blitter-module)\n')
  119.   CASE ERR_JOY; WriteF('Error: Init() (JoyData-object)\n')
  120.   CASE ERR_SCR; WriteF('Error: Opening screen\n')
  121.   CASE ERR_LOAD; WriteF('Error: Loading background-picture\n')
  122.   CASE ERR_RESTORE; WriteF('Error: Init() (Restore-object)\n')
  123.   CASE ERR_BOB; WriteF('Error: Init() (Blitter Object)\n')
  124.   ENDSELECT
  125.   CleanUp(0)
  126. ENDPROC
  127.  
  128. PROC demo()
  129.   DEF anim=0,fire=FALSE,frame
  130.  
  131.   REPEAT
  132.     Activate(rstore)
  133.     DrawBob(worm)
  134.     WaitAVBL()
  135.     SwapBuffers(scr)
  136.  
  137.     INC anim  
  138.     IF (fire=FALSE)
  139.       IF (anim>5)
  140.         anim:=0
  141.         
  142.         frame:=worm.frame
  143.         INC frame
  144.         worm.frame:=frame
  145.  
  146.         IF (worm.frame>9) THEN worm.frame:=0
  147.       ENDIF
  148.     ELSEIF (anim>1)
  149.       IF (worm.frame<10) THEN worm.frame:=9
  150.       frame:=worm.frame
  151.       INC frame
  152.       worm.frame:=frame
  153.       IF (worm.frame>12)
  154.         IF (joy.buttons AND JD_FIRE1)
  155.           worm.frame:=11
  156.         ELSE
  157.           worm.frame:=0
  158.           fire:=FALSE
  159.         ENDIF
  160.       ENDIF
  161.     ENDIF
  162.     Query(joy)    -> Read the joystick!
  163.     worm.xcoord:=worm.xcoord+joy.xchange
  164.     worm.ycoord:=worm.ycoord+joy.ychange
  165.     wrap(worm)
  166.  
  167.     IF (joy.buttons AND JD_FIRE1) THEN fire:=TRUE
  168.     IF Mouse()=2 THEN RETURN
  169.  
  170.     Query(mouse)  -> Note: Just so we can quit with the mouse!
  171.   UNTIL (mouse.buttons AND JD_LMB)
  172.  
  173.  
  174.   /* Screenwipe effect.. (sometimes ;^) )*/
  175.   -> NOTE: This effect was removed, just insert it from
  176.   ->       RamboWorm.e if you must have it here!! :-)
  177. ENDPROC
  178.  
  179. PROC wrap(bb:PTR TO bob)
  180.   IF (bb.xcoord < (bb.width*-1))        THEN bb.xcoord:=bb.destbitmap.width
  181.   IF (bb.xcoord > bb.destbitmap.width)  THEN bb.xcoord:=-bb.width
  182.   IF (bb.ycoord < (bb.height*-1))       THEN bb.ycoord:=bb.destbitmap.height
  183.   IF (bb.ycoord > bb.destbitmap.height) THEN bb.ycoord:=-bb.height
  184. ENDPROC
  185.